home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / numbers.swg / 0054_Permutinf Words.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-25  |  2.1 KB  |  90 lines
  1. {
  2. Here is another attempt. It will also work with any length string
  3. and generates all permutations without running out of memory, by
  4. searching in a depth-first fashion.
  5. }
  6.  
  7. {$M 64000,0,655360}
  8.  
  9. program perms2;
  10.  
  11. uses  Crt;
  12.  
  13. type  str52 = string[52];
  14.  
  15. const objects : str52 = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
  16.  
  17. var   m, n,
  18.       fw, level,
  19.       nperline   : integer;
  20.       p1, p2     : str52;
  21.       nperms     : longint;
  22.  
  23. procedure p (var p1, p2 : str52; var level : integer);
  24. var p1n, p2n  : str52;
  25.     i, nlevel : integer;
  26. begin
  27.   if level < m
  28.   then
  29.      begin
  30.        nlevel := level + 1;
  31.        for i := 1 to length(p2) do
  32.        begin
  33.          p1n := p1 + p2[i];
  34.          p2n := p2;
  35.          delete (p2n, i, 1);
  36.          p (p1n, p2n, nlevel);
  37.        end;
  38.      end
  39.   else
  40.      begin
  41.        write (p1:fw);
  42.        inc (nperms);
  43.      end;
  44. end;
  45.  
  46. begin
  47.   repeat
  48.     clrscr;
  49.     repeat
  50.       write ('How many objects altogether?  ');
  51.       readln (n);
  52.     until (n>=0) and (n<53);
  53.     if n>0
  54.     then
  55.        begin
  56.          repeat
  57.            write ('How many in each permutation? ');
  58.            readln (m);
  59.          until (m>0) and (m<=n);
  60.          writeln;
  61.          case m of
  62.            1      : fw := 2;    { 40 per line }
  63.            2..3   : fw := 4;    { 20 per line }
  64.            4      : fw := 5;    { 16 per line }
  65.            5..7   : fw := 8;    { 10 per line }
  66.            8..9   : fw := 10;   { 8 per line }
  67.            10..15 : fw := 16;   { 5 per line }
  68.            16..19 : fw := 20;   { 4 per line }
  69.            20..39 : fw := 40;   { 2 per line }
  70.            40..52 : fw := 80;   { 1 per line }
  71.          end;
  72.          nperline := 80 div fw;
  73.          level := 0;
  74.          p1 := '';
  75.          p2 := copy (objects, 1, n);
  76.          nperms := 0;
  77.          p (p1, p2, level);
  78.          if (nperms mod nperline) <> 0 then writeln;
  79.          writeln;
  80.          writeln (nperms,' Permutations generated.');
  81.          readln;
  82.        end;
  83.   until n=0;
  84. end.
  85. {
  86. This one is a little more elegant, and should also be a little
  87. easier to decipher than the last one! Hope this will be of some
  88. use to you!
  89. }
  90.